home *** CD-ROM | disk | FTP | other *** search
/ CD ROM Paradise Collection 4 / CD ROM Paradise Collection 4 1995 Nov.iso / program / swags_z.zip / TSR.SWG / 0008_Write to DISK in a TSR.pas < prev    next >
Pascal/Delphi Source File  |  1993-07-16  |  7KB  |  287 lines
  1. ===========================================================================
  2.  BBS: Canada Remote Systems
  3. Date: 06-23-93 (10:24)             Number: 27349
  4. From: STEVE MULLIGAN               Refer#: NONE
  5.   To: EDWARD WALKER                 Recvd: NO  
  6. Subj: TSRS THAT WRITE TO DISK..      Conf: (1221) F-PASCAL
  7. ---------------------------------------------------------------------------
  8. Tuesday June 22 1993 02:38, Edward Walker wrote to All:
  9.  
  10.  EW> What do I need to set up in the code to write to disk in a TSR?
  11.  
  12. Here's a TSR called BootRes.  It opens a file and writes to disk every x
  13. seconds :
  14.  
  15. =-=-=-=-=-=-=-=-= PART 1 =-=-=-=-=-=-=-=-=-=
  16. program BootRes;
  17.  
  18. {$M 2048,0,0}
  19. {$F+}
  20.  
  21. Uses BootVars, Crt, Dos;
  22.  
  23. const
  24.  OLDSTACKSS :  WORD = 0;
  25.  OLDSTACKSP :  WORD = 0;
  26.  STACKSW :    INTEGER = - 1;
  27.  OurStackSeg : word = 0;
  28.  OurStackSp  : word = 0;
  29.  DosDelimSet : set of Char = ['\', ':', #0];
  30.  
  31. var
  32.  R                    : registers;
  33.  DosSeg, DosBusy              : word;
  34.  Tick, WaitBuf               : integer;
  35.  NeedPop                 : boolean;
  36.  
  37. PROCEDURE BEGINint;
  38. INLINE($FF/$06/STACKSW/
  39.    $75/$10/
  40.    $8C/$16/OLDSTACKSS/
  41.        $89/$26/OLDSTACKSP/
  42.        $8E/$16/OURSTACKSEG/
  43.        $8B/$26/OURSTACKSP);
  44.  
  45. PROCEDURE ENDint;
  46. INLINE($FF/$0E/STACKSW/
  47.        $7D/$08/
  48.        $8E/$16/OLDSTACKSS/
  49.    $8B/$26/OLDSTACKSP);
  50.  
  51. PROCEDURE CALLPOP(SUB:POINTER);
  52. BEGIN
  53. INLINE($FF/$5E/$06);
  54. END;
  55.  
  56. PROCEDURE CLI; INLINE($FA);
  57. PROCEDURE STI; INLINE($FB);
  58.  
  59. function Exist(fname : string) : boolean;
  60. var
  61.      f1  : file;  err : integer;
  62. begin
  63.      {$I-}
  64.      assign(f1,fname);     reset(f1);     err := ioresult;
  65.      {$I+}
  66.      if  err = 0 then close(f1);     exist := err = 0;
  67. end;
  68.  
  69.   function AddBackSlash(DirName : string) : string;
  70.     {-Add a default backslash to a directory name}
  71.   begin
  72.     if DirName[Length(DirName)] in DosDelimSet then
  73.       AddBackSlash := DirName
  74.     else
  75.       AddBackSlash := DirName+'\';
  76.   end;
  77.  
  78. procedure TsrCrap;
  79. begin
  80.  CLI;
  81.  BEGINint;
  82.  STI;
  83.  
  84.  NeedPop := False;
  85.  
  86.  GetDate(h, m, s, hund);
  87.  TimeLoad.Year := h;
  88.  TimeLoad.Month := m;
  89.  TimeLoad.Day := s;
  90.  GetTime(h, m, s, hund);
  91.  TimeLoad.Hour := h;
  92.  TimeLoad.Min := m;
  93.  TimeLoad.Sec := s;
  94.  
  95.  DoDate;
  96.  DoDate2;
  97.  
  98.  if not exist(LogName) then begin
  99.   assign(LogFile, LogName);
  100.   rewrite(LogFile);
  101.   write(LogFile, LogRec);
  102.   close(LogFile);
  103.  end;
  104.  
  105.  assign(LogFile, LogName);
  106.  reset(LogFile);
  107.  if FileSize(LogFile) = 0 then begin
  108.   close(LogFile);
  109.   assign(LogFile, LogName);
  110.   rewrite(LogFile);
  111.   write(LogFile, LogRec);
  112.   close(LogFile);
  113.   assign(LogFile, LogName);
  114.   reset(LogFile);
  115.  end;
  116.  seek(LogFile, FileSize(LogFile) - 1);
  117.  read(LogFile, LogRec);
  118.  DoDate2;
  119.  seek(LogFile, FileSize(LogFile) - 1);
  120.  write(LogFile, LogRec);
  121.  close(LogFile);
  122.  Tick := 0;
  123.  
  124.  CLI;
  125.  ENDint;
  126.  STI;
  127. end;
  128. =-=-=-=-=-=-=-=-= PART 1 =-=-=-=-=-=-=-=-=-=
  129.  
  130. --- GoldED 2.41
  131.  * Origin: Ask me about SubMove * Carp, Ontario (1:163/307.30)
  132. ===========================================================================
  133.  BBS: Canada Remote Systems
  134. Date: 06-23-93 (10:25)             Number: 27350
  135. From: STEVE MULLIGAN               Refer#: NONE
  136.   To: EDWARD WALKER                 Recvd: NO  
  137. Subj: TSRS THAT WRITE TO DISK..      Conf: (1221) F-PASCAL
  138. ---------------------------------------------------------------------------
  139. =-=-=-=-=-=-=-=-= PART 2 =-=-=-=-=-=-=-=-=-=
  140. procedure RunTSR; Interrupt;
  141. begin
  142.  CLI;
  143.  BEGINint;
  144.  STI;
  145.  inc(Tick);
  146.  if Tick > 18.2 * WaitBuf then begin
  147.   NeedPop := True;
  148.   if MEM[DosSeg:DosBusy] = 0 then begin
  149.    NeedPop := False;
  150.    PORT[$20] := $20;
  151.    TsrCrap;
  152.   end;
  153.  end;
  154.  CLI;
  155.  ENDint;
  156.  STI;
  157. end;
  158.  
  159. procedure Int28TSR; Interrupt;
  160. begin
  161.  CLI;
  162.  BEGINint;
  163.  STI;
  164.  if NeedPop = True then TsrCrap;
  165.  CLI;
  166.  ENDint;
  167.  STI;
  168. end;
  169.  
  170. procedure InitTSR;
  171. begin
  172.  OurStackSeg := SSEG;
  173.  InLine($89/$26/OurStackSp);
  174.  R.Ah := $34;
  175.  MSDOS(R);
  176.  DosSeg := R.ES;
  177.  DosBusy := R.BX;
  178. end;
  179.  
  180. procedure ShowHelp;
  181. begin
  182.  writeln('Usage : BOOTRES <command line options>');
  183.  writeln;
  184.  writeln('Valid Options : #    Number of seconds to wait before writing current
  185. time');
  186.  writeln('                /?   This screen');
  187. end;
  188.  
  189. begin
  190.  InitTSR;
  191.  
  192.  GetDir(0, LogName);
  193.  LogName := AddBackSlash(LogName) + 'BOOTLOG.DAT';
  194.  WaitBuf := 60;
  195.  
  196.  writeln;
  197.  
  198.  if ParamCount > 0 then begin
  199.   if ParamStr(1) = '/?' then begin
  200.    ShowHelp;
  201.    halt(0);
  202.   end;
  203.   val(ParamStr(1), WaitBuf, Tick);
  204.   if (Tick <> 0) or ((WaitBuf > 60 * 10) or (WaitBuf < 5)) then begin
  205.    writeln('Must be an integer between 5 and ', 60 * 10);
  206.    halt(1);
  207.   end;
  208.  end else begin
  209.   writeln('Type BOOTRES /? for help');
  210.   writeln;
  211.  end;
  212.  
  213.  Tick := 0;
  214.  
  215.  SetIntVec($28,@Int28TSR);
  216.  SetIntVec($1C,@RunTSR);
  217.  
  218.  writeln('BootRes installed');
  219.  
  220.  keep(0);
  221. end. =-=-=-=-=-=-=-=-= PART 2 =-=-=-=-=-=-=-=-=-=
  222.  
  223. --- GoldED 2.41
  224.  * Origin: Ask me about VoteFix * Carp, Ontario (1:163/307.30)
  225. ===========================================================================
  226.  BBS: Canada Remote Systems
  227. Date: 06-23-93 (10:26)             Number: 27351
  228. From: STEVE MULLIGAN               Refer#: NONE
  229.   To: EDWARD WALKER                 Recvd: NO  
  230. Subj: TSRS THAT WRITE TO DISK..      Conf: (1221) F-PASCAL
  231. ---------------------------------------------------------------------------
  232. =-=-=-=-=-=-=-=-= PART 3 =-=-=-=-=-=-=-=-=-=
  233. unit BootVars;
  234.  
  235. interface
  236.  
  237. uses Dos;
  238.  
  239. const
  240.  Version  = '1.00';
  241.  ProgName = 'BootLog';
  242.         CopYear  = '1992 - 1993';
  243.  
  244. type
  245.  LogType = record
  246.   TimeLoad : DateTime;
  247.   TimeOff : DateTime;
  248.  end;
  249.  
  250. var
  251.  LogFile    : file of LogType;
  252.  LogRec    : LogType;
  253.  h, m, s, hund  : word;
  254.  TimeLoad, TimeOff : DateTime;
  255.  LogName    : string;
  256.  
  257. procedure DoDate;
  258. procedure DoDate2;
  259.  
  260. implementation
  261.  
  262. procedure DoDate;
  263. begin
  264.  LogRec.TimeLoad.Year  := TimeLoad.Year;
  265.  LogRec.TimeLoad.Month := TimeLoad.Month;
  266.  LogRec.TimeLoad.Day   := TimeLoad.Day;
  267.  LogRec.TimeLoad.Hour  := TimeLoad.Hour;
  268.  LogRec.TimeLoad.Min   := TimeLoad.Min;
  269.  LogRec.TimeLoad.Sec   := TimeLoad.Sec;
  270. end;
  271.  
  272. procedure DoDate2;
  273. begin
  274.  LogRec.TimeOff.Year   := TimeLoad.Year;
  275.  LogRec.TimeOff.Month  := TimeLoad.Month;
  276.  LogRec.TimeOff.Day    := TimeLoad.Day;
  277.  LogRec.TimeOff.Hour   := TimeLoad.Hour;
  278.  LogRec.TimeOff.Min    := TimeLoad.Min;
  279.  LogRec.TimeOff.Sec    := TimeLoad.Sec;
  280. end;
  281.  
  282. end.
  283. =-=-=-=-=-=-=-=-= PART 3 =-=-=-=-=-=-=-=-=-=
  284.  
  285. --- GoldED 2.41
  286.  * Origin: Ask me about SubMove * Carp, Ontario (1:163/307.30)
  287.